home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / URI / urn / isbn.pm next >
Encoding:
Perl POD Document  |  2008-04-02  |  2.5 KB  |  103 lines
  1. package URI::urn::isbn;  # RFC 3187
  2.  
  3. require URI::urn;
  4. @ISA=qw(URI::urn);
  5.  
  6. use strict;
  7. use Carp qw(carp);
  8.  
  9. BEGIN {
  10.     require Business::ISBN;
  11.     
  12.     local $^W = 0; # don't warn about dev versions, perl5.004 style
  13.     warn "Using Business::ISBN version " . Business::ISBN->VERSION . 
  14.         " which is deprecated.\nUpgrade to Business::ISBN version 2\n"
  15.         if Business::ISBN->VERSION < 2;
  16.     }
  17.     
  18. sub _isbn {
  19.     my $nss = shift;
  20.     $nss = $nss->nss if ref($nss);
  21.     my $isbn = Business::ISBN->new($nss);
  22.     $isbn = undef if $isbn && !$isbn->is_valid;
  23.     return $isbn;
  24. }
  25.  
  26. sub _nss_isbn {
  27.     my $self = shift;
  28.     my $nss = $self->nss(@_);
  29.     my $isbn = _isbn($nss);
  30.     $isbn = $isbn->as_string if $isbn;
  31.     return($nss, $isbn);
  32. }
  33.  
  34. sub isbn {
  35.     my $self = shift;
  36.     my $isbn;
  37.     (undef, $isbn) = $self->_nss_isbn(@_);
  38.     return $isbn;
  39. }
  40.  
  41. sub isbn_publisher_code {
  42.     my $isbn = shift->_isbn || return undef;
  43.     return $isbn->publisher_code;
  44. }
  45.  
  46. BEGIN {
  47. my $group_method = do {
  48.     local $^W = 0; # don't warn about dev versions, perl5.004 style
  49.     Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code';
  50.     };
  51.  
  52. sub isbn_group_code {
  53.     my $isbn = shift->_isbn || return undef;
  54.     return $isbn->$group_method;
  55. }
  56. }
  57.  
  58. sub isbn_country_code {
  59.     my $name = (caller(0))[3]; $name =~ s/.*:://;
  60.     carp "$name is DEPRECATED. Use isbn_group_code instead";
  61.     
  62.     no strict 'refs';
  63.     &isbn_group_code;
  64. }
  65.  
  66. BEGIN {
  67. my $isbn13_method = do {
  68.     local $^W = 0; # don't warn about dev versions, perl5.004 style
  69.     Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean';
  70.     };
  71.  
  72. sub isbn13 {
  73.     my $isbn = shift->_isbn || return undef;
  74.     
  75.     # Business::ISBN 1.x didn't put hyphens in the EAN, and it was just a string
  76.     # Business::ISBN 2.0 doesn't do EAN, but it does ISBN-13 objects
  77.     #   and it uses the hyphens, so call as_string with an empty anon array
  78.     # or, adjust the test and features to say that it comes out with hyphens.
  79.     my $thingy = $isbn->$isbn13_method;
  80.     return eval { $thingy->can( 'as_string' ) } ? $thingy->as_string([]) : $thingy;
  81. }
  82. }
  83.  
  84. sub isbn_as_ean {
  85.     my $name = (caller(0))[3]; $name =~ s/.*:://;
  86.     carp "$name is DEPRECATED. Use isbn13 instead";
  87.  
  88.     no strict 'refs';
  89.     &isbn13;
  90. }
  91.  
  92. sub canonical {
  93.     my $self = shift;
  94.     my($nss, $isbn) = $self->_nss_isbn;
  95.     my $new = $self->SUPER::canonical;
  96.     return $new unless $nss && $isbn && $nss ne $isbn;
  97.     $new = $new->clone if $new == $self;
  98.     $new->nss($isbn);
  99.     return $new;
  100. }
  101.  
  102. 1;
  103.